home *** CD-ROM | disk | FTP | other *** search
/ Almathera Ten Pack 3: CDPD 3 / Almathera Ten on Ten - Disc 3: CDPD3.iso / scope / 126-150 / scopedisk133 / basprghelp / listreqexample.bas < prev   
Encoding:
BASIC Source File  |  1995-03-19  |  9.7 KB  |  359 lines
  1. REM This is a fully functioning List Requestor.  Like a File Requestor
  2. REM it's used to display a list of strings from which the user may
  3. REM select one or more elements while being able to scroll through
  4. REM the list using either a Prop gadget or Up and Down scroll arrows.
  5. REM
  6. REM by Steven D. Kapplin, CIS 70055,1021
  7. REM June 15, 1990
  8. REM Written in HiSoft Basic
  9. REM
  10. REM Compiles to approximately 8,600 bytes (w/o library).
  11. REM Example of a list requestor.  It sets up a requestor and prop gadget
  12. REM to scroll a list of items in the text box and allow an item or items to
  13. REM be selected.  The selected items are placed in an array, index%()
  14. REM which keeps track of the items selected.  A counter, ix%, keeps
  15. REM track of the number of selected items.  When the "Done" gadget
  16. REM is hit, the program then lists the selected items using the index%()
  17. REM array as an index to the string array, s$().
  18. REM Strings can be a maximum of 15 characters and will be truncated if
  19. REM longer and padded with spaces if shorter.
  20. REM Some of this code is part of a larger library of Basic intuition
  21. REM subroutines, which has been included in this archive for others to
  22. REM use.  It was derived from Halfhill and Brannon's Advanced Amiga
  23. REM Basic and modified by me.  Several of the routines included in this
  24. REM listing have been modified from those in the library listings.  You
  25. REM can replace those functions, if you feel the need for the changes.
  26. REM The code here does not include routines for deleting items from a
  27. REM list, but that should be simple enough to add.  This example only
  28. REM adds items to the list.  If an item is re-clicked, although it is
  29. REM de-selected, it will still show up in the list because there is no
  30. REM code for deleting it and collapsing the list.  Also there has been
  31. REM no attempt to sort the list, so items appear in the order selected.
  32. REM 
  33. REM
  34.  
  35. REM From Intuits.header
  36. COMMON SHARED which%,BoxIndex%,MaxLen%,ScrID%,Sheight%
  37. DIM work%(400),p%(100)
  38. DIM x1%(51),y1%(51),x2%(51),y2%(51)
  39. REM Set ScrID% to -1 for WB
  40. ScrID%=-1
  41. which%=0 'which% box is selected
  42. BoxIndex%=1 'How many gadgets
  43. maxlen%=15 'length of text fields
  44. REM 
  45.  
  46.  
  47. 'Define number of items in list and items displayed in text box
  48. 'NumEls% = total number of items in list
  49. 'ElsDisp% = items displayed at one time
  50. NumEls%=50 : ElsDisp%=6
  51.  
  52. 'This sets up a list of items
  53. 'The items are padded to 12 characters max with spaces
  54. 'If items larger than 12 characters, then they are truncated
  55. DIM s$(NumEls%),index%(NumEls%)
  56. FOR i%=0 to 49
  57.     s$(i%)="String "+STR$(i%)
  58.     IF LEN(s$(i%))>15 THEN s$(i%)=LEFT$(s$(i%),15)
  59.     IF LEN(s$(i%))<15 THEN s$(i%)=s$(i%)+SPACE$(15-LEN(s$(i%)))
  60. NEXT i%
  61. '
  62. '
  63. 'Some constants
  64. 'bx% = list box left edge
  65. 'by% = list box top edge
  66. 'Bwidth% = list box width
  67. 'Bheight% = list box height
  68. 'Ght% = item height in list
  69. 'PtabOffset% = fudge for PTAB function
  70. bx%=100 : by%=30 : Bwidth%=122 : Bheight%=60 : Ght%=10 : PtabOffset%=7
  71. '
  72. 'Define values for prop gadget, some are relative to list box
  73. 'px% = propgad left edge
  74. 'py% = propgad top edge
  75. 'Pwidth% = propgad width
  76. 'Pheight% = propgad height
  77. Pwidth%=10 : Pheight%=Bheight%-20 : px%=bx%+Bwidth%+6 : py%=by%+10
  78. '
  79. 'Make text box
  80. LINE (bx%-2,by%-2)-(bx%+Bwidth%,by%+Bheight%),WINDOW(6)-2,b
  81. LINE (bx%-6,by%-6)-(bx%+Bwidth%+Pwidth%+16,by%+Bheight%+20),WINDOW(6),b
  82.  
  83.  
  84. 'Initial display of first ElsDisp% items
  85. FOR i%=0 TO ElsDisp%-1
  86.     PRINT PTAB(bx%,by%+i%*Ght%+PtabOffset%) : CALL SmallTxGad(SPACE$(13))
  87.     PRINT PTAB(bx%,by%+i%*Ght%+PtabOffset%);s$(l%+i%)
  88. NEXT i%
  89.  
  90. 'Make prop gadget
  91. CALL MakeProp(px%,py%,PWidth%,Pheight%,ElsDisp%,NumEls%)
  92.  
  93. 'make Up and Down arrow gadgets
  94. CALL Gadget(px%-2,py%-14,15,11,-1,0)
  95. CALL Gadget(px%-2,py%+Pheight%+2,15,11,-1,0)
  96.  
  97. AREA (px%+Pwidth%/2,py%-13)
  98. AREA STEP (-Pwidth%/2,9)
  99. AREA STEP (9,0)
  100. AREAFILL
  101. AREA (px%,py%+Pheight%+2)
  102. AREA STEP (Pwidth%/2,9)
  103. AREA STEP (Pwidth%/2,-9)
  104. AREAFILL
  105.  
  106. 'Make Done and Cancel gadgets
  107. '
  108. PRINT PTAB(bx%-2,by%+Bheight%+14) : CALL SmallTxBox("Done")
  109. PRINT PTAB(bx%+Bwidth%-52,by%+Bheight%+14) : CALL SmallTxBox("Cancel")
  110. '
  111. 'Main loop
  112. pos%=py%
  113. ix%=0
  114. DO
  115.     CALL WaitBox(gad%)
  116.     SELECT CASE gad%
  117.         CASE 7
  118.             DO WHILE MOUSE(0)=-1
  119.                 l%=INT((pos%-py%)/(Pheight%-Sheight%-2)*(NumEls%-ElsDisp%))
  120.                 CALL SliderPos(gad%,pos%,1)
  121.                 CALL Delay(.05)
  122.                 GOSUB DoDisplay
  123.             LOOP
  124.         CASE 8
  125.             CALL FlashRelease(gad%)
  126.             IF l%>0 THEN
  127.                 DECR l%
  128.                 CALL SliderPos(7,pos%,-1)
  129.                 GOSUB DoDisplay
  130.             END IF
  131.         CASE 9
  132.             CALL FlashRelease(gad%)
  133.             IF l%<NumEls%-ElsDisp% THEN
  134.                 INCR l%
  135.                 CALL SliderPos(7,pos%,0)
  136.                 GOSUB DoDisplay
  137.             END IF
  138.         CASE 1 TO ElsDisp%
  139.             CALL FlashRelease(gad%)
  140.             CALL CheckBox(gad%,1)
  141.             INCR ix%
  142.             index%(ix%)=l%+gad%-1
  143.         CASE 10
  144.             CALL FlashRelease(gad%)
  145.             CLS
  146.             IF ix% > 0 THEN
  147.                 for i%=1 to ix%
  148.                 PRINT s$(index%(i%))
  149.                 next i%
  150.             END IF
  151.             END
  152.         CASE 11
  153.             CALL FlashRelease(gad%)
  154.             ix%=0
  155.             CLS
  156.             END
  157.     END SELECT
  158. LOOP
  159.  
  160. SUB Delay(t!)
  161. 't! is amount of time to delay
  162. '
  163.     p!=TIMER
  164.     WHILE TIMER < (p!+t!)
  165.     WEND
  166. END SUB
  167.  
  168. REM From Intuits.SUB
  169. REM
  170. REM MakeProp
  171. SUB MakeProp(Xmin%,Ymin%,PropWidth%,PropHeight%,EleDisplayed%,TotNumEls%)
  172. 'Make a proportional gadget
  173. 'Xmin% = Left edge
  174. 'Ymin% = Top edge
  175. 'PropWidth% = width of propgad box
  176. 'PropHeight% = height of propgad box
  177. 'EleDisplayed% = number of elements displayed at one time
  178. 'TotNumEls% = total number of elements in list
  179. '
  180.     SHARED Sheight%,x1%(),y1%(),x2%(),y2%(),BoxIndex%,p%()
  181.     Swidth%=PropWidth%
  182.     Sheight%=EleDisplayed%/TotNumEls%*PropHeight%
  183.     LINE (Xmin%,Ymin%)-(Xmin%+Swidth%,Ymin%+Sheight%),,bf
  184.     GET (Xmin%,Ymin%)-(Xmin%+Swidth%,Ymin%+Sheight%),p%
  185.     LINE (Xmin%-2,Ymin%-2)-(Xmin%+PropWidth%+2,Ymin%+PropHeight%),,b
  186.     x1%(BoxIndex%)=Xmin% : y1%(BoxIndex%)=Ymin%
  187.     x2%(BoxIndex%)=Xmin%+PropWidth% : y2%(BoxIndex%)=Ymin%+PropHeight%
  188.     BoxIndex%=BoxIndex%+1
  189. END SUB
  190.  
  191. REM SliderPos
  192. SUB SliderPos(i%,NewPos%,fl%)
  193. 'Positions proportional gadget slider
  194. 'i% = gadget ID number
  195. 'NewPos% = input/output = position of slider
  196. 'You can get the index value associated with the change in slider position
  197. ' by using the following line:
  198. ' l%=INT((pos%-y%)/(Pheight%-Sheight%-2)*(TotNumEls%-NumElsDisplayed%))
  199. ' which is placed in the intuition message loop.
  200. ' 
  201.     SHARED Sheight%,x1%(),y1%(),x2%(),y2%(),p%()
  202.     PUT (x1%(i%),NewPos%),p%
  203.     IF fl%=1 THEN
  204.         NewPos%=MOUSE(2)-1
  205.     ELSEIF fl%=0 THEN
  206.         INCR NewPos%
  207.     ELSEIF fl%=-1 THEN
  208.         DECR NewPos%
  209.     END IF
  210.     IF NewPos% > y2%(i%)-Sheight%-2 THEN NewPos%=y2%(i%)-Sheight%-2
  211.     IF Newpos% < y1%(i%) THEN NewPos%=y1%(i%)
  212.     PUT (x1%(i%),Newpos%),p%
  213. END SUB    
  214.  
  215. REM SmallTxBox
  216. 'Gadget box with text in msg$
  217. SUB SmallTxBox(msg$) STATIC
  218.     SHARED x1%(),y1%(),x2%(),y2%()
  219.     SHARED BoxIndex%
  220.     x1%=WINDOW(4) : y1%=WINDOW(5)-8
  221.     PRINT " ";msg$;" ";
  222.     x2%=WINDOW(4) : y2%=y1%+11
  223.     CALL Box(BoxIndex%,x1%,y1%,x2%,y2%,-1)
  224.     BoxIndex%=BoxIndex%+1
  225.     PRINT SPC(1);
  226. END SUB
  227.  
  228. REM SmallTxGad
  229. 'Text gadget without a box
  230. SUB SmallTxGad(msg$) STATIC
  231.     SHARED x1%(),y1%(),x2%(),y2%()
  232.     SHARED BoxIndex%
  233.     x1%=WINDOW(4) : y1%=WINDOW(5)-7
  234.     PRINT " ";msg$;" ";
  235.     x2%=WINDOW(4) : y2%=y1%+10
  236.     CALL NoBoxGad(BoxIndex%,x1%,y1%,x2%,y2%)
  237.     BoxIndex%=BoxIndex%+1
  238.     PRINT SPC(1);
  239. END SUB
  240.  
  241. REM Gadget
  242. 'Plain gadget
  243. SUB Gadget(x%,y%,wid%,ht%,bflag%,shflag%) STATIC
  244. 'x%=left edge
  245. 'y%=top edge
  246. 'wid%=width
  247. 'ht%=height
  248. 'if blfag%=0 no box, if=-1 then box
  249. 'shflag%=0 no shadow, -1 for shadow
  250.     SHARED x1%(),y1%(),x2%(),y2%()
  251.     SHARED BoxIndex%
  252.     IF bflag%=-1 THEN
  253.         CALL Box(BoxIndex%,x%,y%,x%+wid%,y%+ht%,shflag%)
  254.     ELSE
  255.         CALL NoBoxGad(BoxIndex%,x%,y%,x%+wid%,y%+ht%)
  256.     END IF
  257.     BoxIndex%=BoxIndex%+1
  258. END SUB
  259.  
  260. REM Box
  261. SUB Box(i%,x1%,y1%,x2%,y2%,f%) STATIC
  262. 'Draw and store a box (i) whose corner
  263. 'coords are (x1,y1)-(x2,y2)
  264. 'Can be used to change a box's coords
  265. 'f% is flag: 0=shadow, -1=no shadow
  266.     SHARED x1%(),y1%(),x2%(),y2%()
  267.     IF x2%<x1% THEN SWAP x1%,x2%
  268.     IF f%=-1 THEN
  269.         LINE (x1%,y1%)-(x2%,y2%),1-(WINDOW(6)>1),b
  270.     END IF
  271.     LINE (x1%,y1%)-(x2%-1,y2%-1),2-(WINDOW(6)>1),b
  272.     x1%(i%)=x1% : y1%(i%)=y1% : x2%(i%)=x2% : y2%(i%)=y2%
  273. END SUB
  274.  
  275. REM WaitBox
  276. SUB WaitBox(which%) STATIC
  277. 'Wait for a box to be selected
  278. 'return box number in (which%)
  279.     which%=0
  280.     WHILE which%=0
  281.         SLEEP
  282.           CALL WhichBox(which%)
  283.     WEND
  284.     EXIT SUB
  285. END SUB
  286.  
  287. REM WhichBox
  288. SUB WhichBox(which%) STATIC
  289. 'See if a box is selected,
  290. 'otherwise (which%)=0
  291. 'Used to poll for box selection
  292.     SHARED x1%(),y1%(),x2%(),y2%(),BoxIndex%
  293.     IF MOUSE(0)=0 THEN EXIT SUB
  294.     x%=MOUSE(1) : y%=MOUSE(2) : i%=1
  295.     WHILE i%<BoxIndex% AND NOT (x%>x1%(i%) AND x%<x2%(i%) AND y%>y1%(i%) AND y%<y2%(i%))
  296.         INCR i%
  297.     WEND
  298.     which%=i%
  299.     IF i%=BoxIndex% THEN which%=0
  300. END SUB
  301.  
  302. REM CheckBox
  303. 'Checks a box when selected.  Actually, changes box color and
  304. 'wipes string
  305. SUB CheckBox(i%,flag%) STATIC
  306. 'Check a box
  307. 'Pass variable (flag)
  308. 'for on/off (-1/0)
  309.     SHARED x1%(),y1%(),x2%(),y2%()
  310.     x1%=x1%(i%) : y1%=y1%(i%)
  311.     x2%=x2%(i%) : y2%=y2%(i%)-1
  312.     COLOR ,,2
  313.     LINE (x1%+1,y1%+1)-(x2%-1,y2%-1),WINDOW(6)*-(flag%<>0),bf
  314.     COLOR ,,1
  315. END SUB
  316.  
  317. REM FlashRelease
  318. SUB FlashRelease(which%) STATIC
  319. 'Flashes button (which%), waits for
  320. 'release of mouse button
  321. 'if mouse moved during release,
  322. 'global variable RelVerify is set to null,
  323. 'else is -1 (true).
  324.     SHARED x1%(),y1%(),x2%(),y2%(),work%()
  325.     SHARED RelVerify%
  326.     'These two lines flash the box
  327.     GET (x1%(which%),y1%(which%))-(x2%(which%),y2%(which%)),work%
  328.     PUT (x1%(which%),y1%(which%)),work%,PRESET
  329.     ix%=MOUSE(1) : iy%=MOUSE(2) : RelVerify%=-1
  330.     WHILE MOUSE(0)<>0
  331.         IF MOUSE(1)<>ix% OR MOUSE(2)<>iy% THEN RelVerify%=0
  332.     WEND
  333.     'This line restores the box
  334.     PUT (x1%(which%),y1%(which%)),work%,PSET
  335. END SUB
  336.  
  337. REM NoBoxGad
  338. SUB NoBoxGad(i%,x1%,y1%,x2%,y2%) STATIC
  339. 'Same as Box(), but doesn't draw a box
  340.     SHARED x1%(),y1%(),x2%(),y2%()
  341.     IF x2%<x1% THEN SWAP x1%,x2%
  342.     x1%(i%)=x1% : y1%(i%)=y1% : x2%(i%)=x2% : y2%(i%)=y2%
  343. END SUB
  344. REM End of Intuits.SUB stuff
  345. REM
  346.  
  347. DoDisplay:
  348.     FOR i%=0 TO ElsDisp%-1
  349.         PRINT PTAB(bx%,by%+Ght%*i%+PtabOffset%);s$(l%+i%)
  350.     NEXT i%
  351.     FOR i%=1 TO ElsDisp%
  352.         FOR j%=1 TO ix%
  353.             IF index%(j%)-l%+1=i% THEN
  354.                 CALL CheckBox(i%,1)
  355.             END IF
  356.         NEXT j%
  357.     NEXT i%
  358. RETURN    
  359.